home *** CD-ROM | disk | FTP | other *** search
- OVERLAY PROCEDURE Emulate_Host;
-
- (*----------------------------------------------------------------------*)
- (* PibHost --- Host mode (mini-BBS) for PibTerm *)
- (*----------------------------------------------------------------------*)
- (* *)
- (* Author: Philip R. Burns *)
- (* Date: July, 1985 *)
- (* Version: 1.0 (July, 1985) *)
- (* 1.1 (July, 1985) *)
- (* 1.2 (August, 1985) *)
- (* 2.0 (August, 1985) *)
- (* 3.0 (October, 1985) *)
- (* *)
- (* Systems: For MS-DOS on IBM PCs and close compatibles only. *)
- (* Note: I have checked these on Zenith 151s under *)
- (* MSDOS 2.1 and IBM PCs under PCDOS 2.0. *)
- (* *)
- (* Overview: This overlay provides a simple host mode for use with *)
- (* PibTerm. Facilities are provided for message leaving *)
- (* and file transfer. This code can be used as a very *)
- (* simple remote bulletin board. However, it lacks the *)
- (* security provisions needed for a genuine BBS, and is *)
- (* really intended to cover the need for a simple remote *)
- (* facility for a small private group of users. *)
- (* *)
- (* Use: This code assumes a Hayes-compatible modem. You may need *)
- (* to modify the code if your modem doesn't return verbal *)
- (* codes sufficient to determine the baud rate of the caller.*)
- (* The modem is assumed to be set to answer the phone *)
- (* automatically. *)
- (* *)
- (* To invoke host mode after entering PibTerm, enter Alt-W. *)
- (* *)
- (* If you want the remote session echoed to the printer or *)
- (* captured to disk, then use the Alt-L and Alt-O commands *)
- (* before using Alt-W to invoke host mode. *)
- (* *)
- (* The following files are required above those normally *)
- (* used with PibTerm: *)
- (* *)
- (* PIBTERM.USF --- the user file. A simple text file *)
- (* containing the first name, last name, *)
- (* and password for each authorized user. *)
- (* This file can be created using any *)
- (* text editor that produces ascii files. *)
- (* The format is simply: *)
- (* *)
- (* firstname;lastname;password *)
- (* *)
- (* i.e., semicolons separating the first *)
- (* name, last name, and password. *)
- (* *)
- (* This file MUST be created outside of *)
- (* PibTerm; there are no provisions for *)
- (* a remote caller to get added to the *)
- (* user file. *)
- (* *)
- (* PIBTERM.MSG --- The message file. This file is also *)
- (* a simple ascii text file. Message *)
- (* header information is flagged by '==' *)
- (* in columns one and two. The end of a *)
- (* message is marked by '== End' in *)
- (* column one. This file will be created *)
- (* by PibTerm if it doesn't exist when a *)
- (* host session requires its presence. *)
- (* *)
- (* To remove messages, use a text editor *)
- (* and just delete the header lines and *)
- (* text for a message. There are no *)
- (* provisions for deleting messages *)
- (* remotely. *)
- (* *)
- (* PIBTERM.XFR --- The file transfer list. This file *)
- (* contains a list of files which may be *)
- (* downloaded by a remote user. Files *)
- (* NOT on the transfer list cannot be *)
- (* downloaded. *)
- (* *)
- (* Also, a file with the same name as a *)
- (* file on this list cannot be uploaded *)
- (* by a remote user. Further, any file *)
- (* with PIBTERM as part of the name *)
- (* can't be transferred, to prevent *)
- (* a remote user from downloading the *)
- (* user or comments files. *)
- (* *)
- (* The easiest way to create this file is *)
- (* to execute the DOS command: *)
- (* *)
- (* DIR >PIBTERM.XFR *)
- (* *)
- (* and then edit the resulting file using *)
- (* a text editor to remove unneeded lines *)
- (* and get the file names into 'name.ext' *)
- (* form as required by PibTerm. *)
- (* *)
- (* PIBTERM.CMT --- private comments file -- only readable *)
- (* by you. The format is the same as the *)
- (* message file. *)
- (* *)
- (* PIBTERM.LOG --- log file telling who logged on and *)
- (* when they logged off. *)
- (* *)
- (* Note that all these files are simple sequential ascii *)
- (* files. This implies that they should be kept small for *)
- (* reasonable performance -- which is fine for a small group *)
- (* of users. This implementation does not provide good *)
- (* performance for a large group of users; if you need that,*)
- (* you should obtain a real BBS program designed to handle *)
- (* large numbers of users. *)
- (* *)
- (* *)
- (*----------------------------------------------------------------------*)
- (* *)
- (* Restriction *)
- (* ----------- *)
- (* *)
- (* You may use this code only for NON COMMERCIAL purposes *)
- (* unless you explicitly obtain my permission. I take a dim *)
- (* view of others making money on my work and those of other *)
- (* people whose code I've inserted here. *)
- (* *)
- (* Please feel free to add new features. I wrote this *)
- (* program to give people a useful and usable basic terminal *)
- (* facility, and to show how Turbo Pascal can be used for *)
- (* asynchronous communications, menu display, windowing, and *)
- (* so on. I hope that you find this program useful -- and, *)
- (* if you expand upon it, please upload your extensions so *)
- (* that all of us can enjoy them! *)
- (* *)
- (*----------------------------------------------------------------------*)
- (* *)
- (* Suggestions for improvements or corrections are welcome. *)
- (* Please leave messages on Gene Plantz's BBS (312) 882 4145 *)
- (* or Ron Fox's BBS (312) 940 6496. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- (*----------------------------------------------------------------------*)
- (* Global host mode variables *)
- (*----------------------------------------------------------------------*)
-
- CONST
- MaxUsers = 15 (* Maximum number of users supported *);
- Page_Size = 23 (* No. lines per screen for display *);
- Max_Login_Try = 3 (* Max. number of tries for login *);
-
- TYPE (* Information about a user *)
-
- User_Record = RECORD
- First_Name: STRING[20];
- Last_Name : STRING[20];
- Password : STRING[10];
- END;
-
- VAR
-
- Done : BOOLEAN (* If session complete *);
- Really_Done : BOOLEAN (* To leave host mode *);
-
- Kbd_Input : BOOLEAN (* Input found at host keybrd *);
- Fname : ShortStr (* First name of caller *);
- Lname : ShortStr (* Last name of caller *);
- PassWord : ShortStr (* Password to access system *);
- First_Time : BOOLEAN (* If first time host mode up *);
- Recipient_Name : AnyStr (* Name for message reception *);
- Message_Subject: AnyStr (* Subject of message *);
- Message_Line : AnyStr (* Text line for message *);
-
- CR_LF_Host : STRING[2] (* CR or CR+LF *);
- Expert_On : BOOLEAN (* TRUE to use short menus *);
-
- User_File : Text_File (* Password file *);
- Message_File : Text_File (* Message file *);
- Comments_File : Text_File (* Comments file *);
- Log_File : Text_File (* Log file *);
-
- (* User list *)
-
- User_List : ARRAY[1 .. MaxUsers] OF User_Record;
-
- NUsers : INTEGER (* Number of active users *);
-
- Cur_User : INTEGER (* Current user *);
- Cur_User_Name : AnyStr (* Current user's name *);
-
- NMessages : INTEGER (* Number of messages *);
-
- Local_Host : BOOLEAN (* TRUE if local host session *);
- Host_Section : CHAR (* Which section are we in? *);
-
- (*----------------------------------------------------------------------*)
- (* Host_Carrier_Detect --- Check for carrier or local mode *)
- (*----------------------------------------------------------------------*)
-
- FUNCTION Host_Carrier_Detect : BOOLEAN;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Function: Host_Carrier_Detect *)
- (* *)
- (* Purpose: Reports on carrier detect/local host mode status *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Carrier := Host_Carrier_Detect : BOOLEAN; *)
- (* *)
- (* Carrier --- set TRUE if local host session, or if *)
- (* carrier detected for remote session. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Host_Carrier_Detect *)
-
- Host_Carrier_Detect := FALSE;
-
- IF Local_Host THEN
- Host_Carrier_Detect := TRUE
- ELSE
- Host_Carrier_Detect := Async_Carrier_Detect;
-
- END (* Host_Carrier_Detect *);
-
- (*----------------------------------------------------------------------*)
- (* Host_Send --- Send character to port/screen in host mode *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Host_Send( Ch : CHAR );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Host_Send *)
- (* *)
- (* Purpose: Sends character to comm port and/or screen *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Host_Send( Ch : CHAR ); *)
- (* *)
- (* Ch --- character to be sent out *)
- (* *)
- (* Remarks: If local host session, character is NOT sent out port. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Host_Send *)
-
- IF ( NOT Local_Host ) THEN
- Async_Send( Ch );
-
- WRITE( Ch );
-
- END (* Host_Send *);
-
- (*----------------------------------------------------------------------*)
- (* Host_Send_String --- Send string to port/screen in host mode *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Host_Send_String( S : AnyStr );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Host_Send_String *)
- (* *)
- (* Purpose: Sends string to comm port and/or screen *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Host_Send_String( S : AnyStr ); *)
- (* *)
- (* S --- character to be sent out *)
- (* *)
- (* Remarks: If local host session, string is NOT sent out port. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Host_Send_String *)
-
- IF ( NOT Local_Host ) THEN
- Async_Send_String( S );
-
- WRITE( S );
-
- IF Printer_On THEN
- WRITE( Lst, S );
-
- IF Capture_On THEN
- WRITE( Capture_File , S );
-
- END (* Host_Send_String *);
-
- (*----------------------------------------------------------------------*)
- (* Host_Send_String_With_CR --- Append CR or CR+LF and send string *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Host_Send_String_With_CR( S : AnyStr );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Host_Send_String_With_CR *)
- (* *)
- (* Purpose: Appends end-of-line characters to string and sends *)
- (* it out over communications port. *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Host_Send_String_With_CR( S: AnyStr ); *)
- (* *)
- (* S --- string to be sent out. *)
- (* *)
- (* Remarks: *)
- (* *)
- (* The end-of-line characters are either a CR or a CR+LF, *)
- (* depending upon the choice made by the user at login time. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Host_Send_String_With_CR *)
-
- IF ( NOT Local_Host ) THEN
- Async_Send_String( S + CR_LF_Host );
-
- WRITELN( S );
-
- IF Printer_On THEN
- WRITELN( Lst, S );
-
- IF Capture_On THEN
- WRITELN( Capture_File , S );
-
- END (* Host_Send_String_With_CR *);
-
- (*----------------------------------------------------------------------*)
- (* Host_Send_String_And_Echo --- Send string and echo it to screen *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Host_Send_String_And_Echo( S : AnyStr );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Host_Send_String_And_Echo *)
- (* *)
- (* Purpose: Send string out com port and echo to screen *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Host_Send_String_And_Echo( S: AnyStr ); *)
- (* *)
- (* S --- string to be sent out and echoed. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Host_Send_String_And_Echo *)
-
- IF ( NOT Local_Host ) THEN
- Async_Send_String( S );
-
- WRITE( S );
-
- IF Printer_On THEN
- WRITE( Lst, S );
-
- IF Capture_On THEN
- WRITE( Capture_File , S );
-
- END (* Host_Send_String_And_Echo *);
-
- (*----------------------------------------------------------------------*)
- (* Host_Prompt_And_Read_String --- Get string from remote and echo *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Host_Prompt_And_Read_String( Prompt : AnyStr;
- VAR S : AnyStr;
- Echo : BOOLEAN );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Host_Prompt_And_Read_String *)
- (* *)
- (* Purpose: Issues prompt to remote user, reads response, and *)
- (* echos response. *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Host_Prompt_And_Read_String( Prompt : AnyStr; *)
- (* VAR S : AnyStr; *)
- (* Echo : BOOLEAN ); *)
- (* *)
- (* Prompt --- prompt string to be issued. *)
- (* If null, no prompt is issued. *)
- (* S --- resulting string received from remote user. *)
- (* Echo --- TRUE to echo characters as they are read; *)
- (* FALSE to echo characters as '.'s. This is *)
- (* useful for getting passwords. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Ch : CHAR;
- GotChar : BOOLEAN;
- XPos : INTEGER;
- Rem_Ch : CHAR;
-
- BEGIN (* Host_Prompt_And_Read_String *)
-
- (* Send prompt to remote user *)
- IF LENGTH( Prompt ) > 0 THEN
- Host_Send_String_And_Echo( Prompt );
-
- Ch := CHR( 0 );
- S := '';
- XPos := WhereX;
- (* Get response string *)
- REPEAT
-
- GotChar := FALSE;
-
- IF KeyPressed THEN
- BEGIN
- READ( Kbd, Ch );
- GotChar := TRUE;
- END;
-
- IF Async_Receive( Rem_Ch ) THEN
- BEGIN
- Ch := Rem_Ch;
- GotChar := TRUE;
- END;
-
- IF GotChar THEN
- IF Ch <> CHR( CR ) THEN
- IF Ch = ^H THEN
- BEGIN (* Backspace *)
- IF WhereX > Xpos THEN
- BEGIN
- Host_Send( Ch );
- Host_Send( ' ' );
- Host_Send( Ch );
- IF LENGTH( S ) > 1 THEN
- S := COPY( S, 2, LENGTH( S ) - 1 )
- ELSE
- S := '';
- END;
- END (* Backspace *)
- ELSE
- BEGIN
- S := S + Ch;
- IF Echo THEN
- Host_Send( Ch )
- ELSE
- Host_Send( '.' );
- END;
-
- UNTIL ( Ch = CHR( CR ) ) OR ( NOT Host_Carrier_Detect );
-
- (* CR ends line *)
- IF Host_Carrier_Detect THEN
- BEGIN
-
- WRITELN;
-
- IF Printer_On THEN
- WRITELN( Lst , S );
-
- IF Capture_On THEN
- WRITELN( Capture_File , S );
-
- END;
-
- END (* Host_Prompt_And_Read_String *);
-
- (*----------------------------------------------------------------------*)
- (* Page_Sysop --- Page sysop to enter gossip mode *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Page_Sysop( VAR Sysop_Found : BOOLEAN );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Page_Sysop *)
- (* *)
- (* Purpose: Pages Sysop to enter gossip mode. *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Page_Sysop( VAR Sysop_Found : BOOLEAN ); *)
- (* *)
- (* Sysop_Found --- TRUE if sysop responds. *)
- (* *)
- (* Remarks: *)
- (* *)
- (* If silent mode is on (Alt_M) then this page is not performed. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Timer: REAL;
- I : INTEGER;
- Ch : CHAR;
-
- BEGIN (* Page_Sysop *)
-
- Host_Send_String_With_CR(' ');
-
- Sysop_Found := FALSE;
-
- IF ( NOT Silent_Mode ) THEN
- BEGIN
-
- Host_Send_String_With_CR('Summoning Sysop ...');
-
- Timer := 30;
-
- REPEAT
-
- FOR I := 1 TO 5 DO
- WRITE( CHR( BELL ) );
-
- IF KeyPressed THEN
- BEGIN
- READ( Kbd, Ch );
- IF ( Ch = CHR( ESC ) ) AND KeyPressed THEN
- READ( Kbd , Ch );
- Sysop_Found := TRUE;
- END;
-
- DELAY( One_Second_Delay );
-
- Timer := Timer - 1.0;
-
- UNTIL ( Timer <= 0.0 ) OR ( Sysop_Found );
-
- END
- ELSE
- Host_Send_String_With_CR('Sysop not available, gossip cancelled.');
-
- END (* Page_Sysop *);
-
- (*----------------------------------------------------------------------*)
- (* List_Prompt --- prompt for end-of-screen *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE List_Prompt( VAR List_Count : INTEGER; VAR List_Done : BOOLEAN );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: List_Prompt *)
- (* *)
- (* Purpose: Issues end-of-screen prompt for view routines *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* List_Prompt( VAR List_Count : INTEGER; *)
- (* VAR List_Done : BOOLEAN ); *)
- (* *)
- (* List_Done --- TRUE if Stop option selected here *)
- (* List_Count --- Count of lines per panel. May be changed *)
- (* here if C option selected. *)
- (* *)
- (* Calls: RvsVideoOn *)
- (* RvsVideoOff *)
- (* *)
- (* Called by: *)
- (* *)
- (* List_Files_For_Transfer *)
- (* Read_Messages *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- List_Char : CHAR;
-
- BEGIN (* List_Prompt *)
-
- List_Count := List_Count + 1;
-
- IF List_Count > Page_Size THEN
- BEGIN (* Do end of screen prompt *)
-
- REPEAT
-
- Host_Send_String_And_Echo('Enter <CR> to continue, S to stop, ' +
- 'C to continue non-stop: ');
-
- REPEAT
- UNTIL ( Async_Receive( List_Char ) OR KeyPressed OR
- ( NOT Host_Carrier_Detect ) );
-
- IF KeyPressed THEN
- READ( KBD, List_Char );
-
- IF List_Char = CHR( CR ) THEN
- List_Char := ' ';
-
- Host_Send_String_With_CR( List_Char );
-
- IF Printer_On THEN
- WRITELN( Lst , List_Char );
- IF Capture_On THEN
- WRITELN( Capture_File , List_Char );
-
- List_Char := UpCase( List_Char );
-
- UNTIL ( List_Char IN ['S', 'C', ' '] ) OR ( NOT Host_Carrier_Detect );
-
- CASE List_Char Of
- 'C': List_Count := -MaxInt;
- 'S': List_Done := TRUE;
- ' ': List_Count := 1;
- ELSE
- ;
- END (* CASE *);
-
- END (* Do end of screen prompt *);
-
- END (* List_Prompt *);
-
- (*----------------------------------------------------------------------*)
- (* Gossip_Mode --- Enter PibTerm gossip mode *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Gossip_Mode;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Gossip_Mode *)
- (* *)
- (* Purpose: Allows "conversation" with remote user. *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Gossip_Mode; *)
- (* *)
- (* Remarks: *)
- (* *)
- (* This gossip mode feature does not use a split screen. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Gossip_Done : BOOLEAN (* TRUE to exit back to host mode *);
- Ch : CHAR (* Character read/written *);
- Bozo : BOOLEAN;
-
- BEGIN (* Gossip_Mode *)
-
- Host_Send_String_With_CR(' ');
- Host_Send_String_With_CR('Entering gossip mode ... ');
- WRITELN('Enter Ctrl-C to exit gossip mode.');
-
- Gossip_Done := FALSE;
- (* Loop over input until done *)
- WHILE ( NOT Gossip_Done ) DO
- BEGIN
- (* Check if XOFF needs to be sent *)
- Async_Buffer_Full;
- (* Check for character typed at keyboard *)
- IF KeyPressed THEN
- BEGIN
-
- READ( Kbd , Ch );
-
- IF ( ORD( Ch ) = ESC ) AND KeyPressed THEN
- BEGIN
- READ( Kbd, Ch );
- IF ( ORD( Ch ) = F1 ) THEN
- Ch := CHR( 3 )
- ELSE IF ( ORD( Ch ) = F2 ) THEN
- BEGIN
- Ch := CHR( 3 );
- Done := TRUE;
- END;
- END;
-
- CASE ORD( Ch ) OF
-
- 3: Gossip_Done := TRUE;
-
- ESC: IF KeyPressed THEN
- BEGIN
- Process_Command( Ch, FALSE, PibTerm_Command );
- IF PibTerm_Command <> Null_Command THEN
- Execute_Command( PibTerm_Command, Bozo, FALSE );
- END
- ELSE
- BEGIN
- IF Local_Echo THEN WRITE( Ch );
- Async_Send( Ch );
- END;
-
-
- BS: BEGIN
- Ch := BS_Char;
- Host_Send( Ch );
- IF Printer_On THEN
- WRITE( Lst , Ch );
- IF Capture_On THEN
- WRITE( Capture_File , Ch );
- END;
-
- DEL: BEGIN
- Ch := Ctrl_BS_Char;
- Host_Send( Ch );
- IF Printer_On THEN
- WRITE( Lst , Ch );
- IF Capture_On THEN
- WRITE( Capture_File , Ch );
- END;
-
- CR: BEGIN
- Host_Send_String( CR_LF_Host );
- IF Printer_On THEN
- WRITELN( Lst );
- IF Capture_On THEN
- WRITELN( Capture_File );
- END;
-
- ELSE
- BEGIN
- Host_Send( Ch );
- IF Printer_On THEN
- WRITE( Lst , Ch );
- IF Capture_On THEN
- WRITE( Capture_File , Ch );
- END;
-
- END (* CASE ORD( Ch ) *);
-
- END;
-
- IF Async_Receive( Ch ) THEN
- BEGIN
- IF Ch = CHR( CR ) THEN
- BEGIN
- IF Printer_On THEN
- WRITELN( Lst );
- IF Capture_On THEN
- WRITELN( Capture_File );
- Host_Send_String( CR_LF_Host );
- END
- ELSE
- Host_Send( Ch );
- END;
-
- END;
-
- END (* Gossip_Mode *);
-
- (*----------------------------------------------------------------------*)
- (* Start of host mode overlay section one *)
- (*----------------------------------------------------------------------*)
-
- CONST
- Start_Host_Overlay_One = 1;
-
- (*----------------------------------------------------------------------*)
- (* Process_File_Transfer_Commands --- Process file transfer commands *)
- (*----------------------------------------------------------------------*)
-
- OVERLAY PROCEDURE Process_File_Transfer_Commands( VAR Done: BOOLEAN;
- VAR Back: BOOLEAN );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Process_File_Transfer_Commands *)
- (* *)
- (* Purpose: Controls processing of file transfer commands. *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Process_File_Transfer_Commands( VAR Done: BOOLEAN; *)
- (* VAR Back: BOOLEAN ); *)
- (* *)
- (* Done --- set TRUE if quit command entered or carrier *)
- (* dropped. *)
- (* Back --- set TRUE if return to main menu requested. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Ch: CHAR;
-
- (*----------------------------------------------------------------------*)
- (* Display_Xfer_Commands --- Display file transfer commands *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Display_Xfer_Commands;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Display_Xfer_Commands *)
- (* *)
- (* Purpose: Displays menu of PibTerm file transfer commands and *)
- (* prompts for command entry. *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Display_Xfer_Commands; *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Display_Xfer_Commands *)
-
- IF ( NOT Expert_On ) THEN
- BEGIN
- Host_Send_String_With_CR('======================================================');
- Host_Send_String_With_CR('= PibTerm Host Mode File Transfer Menu =');
- Host_Send_String_With_CR('======================================================');
- Host_Send_String_With_CR(' ');
- Host_Send_String_With_CR(' U=Upload file');
- Host_Send_String_With_CR(' D=Download file');
- Host_Send_String_With_CR(' L=List files for transfer');
- Host_Send_String_With_CR(' M=Return to main menu');
- Host_Send_String_With_CR(' Q=Quit and logoff');
- Host_Send_String_With_CR(' X=Expert mode');
- Host_Send_String_With_CR(' ');
- Host_Send_String_With_CR('======================================================');
- Host_Send_String_With_CR(' ');
- Host_Send_String_And_Echo('Enter command ? ');
- END
- ELSE
- BEGIN
- Host_Send_String_With_CR(' ');
- Host_Send_String_And_Echo('Xfer (U,D,L,M,Q,X) ? ');
- END;
-
- END (* Display_Xfer_Commands *);
-
-
- (*----------------------------------------------------------------------*)
- (* List_Files_For_Transfer --- List files available for transfer *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE List_Files_For_Transfer;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: List_Files_For_Transfer *)
- (* *)
- (* Purpose: Displays files available for transfer. *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* List_Files_For_Transfer; *)
- (* *)
- (* *)
- (* Remarks: *)
- (* *)
- (* This procedure sends the contents of the PIBTERM.XFR file to *)
- (* the remote user. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- LCount : INTEGER;
- LDone : BOOLEAN;
- XFer_Line : AnyStr;
-
- BEGIN (* List_Files_For_Transfer *)
- (* Open xferlist file *)
-
- ASSIGN( Xfer_List_File , Home_Dir + 'PIBTERM.XFR' );
- (*$I-*)
- RESET( Xfer_List_File );
- (*$I+*)
- (* If not there, no transfer possible *)
- IF Int24Result <> 0 THEN
- BEGIN
- Host_Send_String( CR_LF_Host );
- Host_Send_String_With_CR('No files available for transfer.');
- END
- ELSE (* If there, list it *)
- BEGIN
-
- LCount := 2;
- LDone := FALSE;
-
- Host_Send_String( CR_LF_Host );
- Host_Send_String_With_CR('List of files available for transfer: ');
- Host_Send_String_With_CR(' ');
-
- List_Prompt( LCount , LDone );
-
- REPEAT
-
- READLN( Xfer_List_File , Xfer_Line );
-
- Host_Send_String_With_CR( Xfer_Line );
-
- List_Prompt( LCount , LDone );
-
- UNTIL ( EOF( Xfer_List_File ) OR LDone );
-
- END;
-
- (*$I-*)
- CLOSE( Xfer_List_File )
- (*$I+*)
-
- END (* List_Files_For_Transfer *);
-
- (*----------------------------------------------------------------------*)
- (* Search_Xfer_List --- Search transfer list for file name *)
- (*----------------------------------------------------------------------*)
-
- FUNCTION Search_Xfer_List( File_Name : AnyStr ) : BOOLEAN;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Function: Search_Xfer_List *)
- (* *)
- (* Purpose: Searches transfer list for given file name. *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Found := Search_Xfer_List( File_Name: AnyStr ) : BOOLEAN; *)
- (* *)
- (* File_Name --- file name to look for. *)
- (* Found --- TRUE if file on transfer list, else FALSE. *)
- (* *)
- (* Remarks: *)
- (* *)
- (* This procedure searches the contents of the PIBTERM.XFR file. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- SDone : BOOLEAN;
- XFer_Line : AnyStr;
-
- BEGIN (* Search_Xfer_List *)
-
- Host_Send_String( CR_LF_Host );
-
- Host_Send_String_With_CR('Scanning file list ... ');
-
- Search_Xfer_List := Scan_Xfer_List( File_Name );
-
- END (* Search_Xfer_List *);
-
- (*----------------------------------------------------------------------*)
- (* Display_Xfer_Protocols --- Display file xfer protocols *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Display_Xfer_Protocols;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Display_Xfer_Protocols; *)
- (* *)
- (* Purpose: Displays available file transfer protocols. *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Display_Xfer_Protocols; *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Display_Xfer_Protocols *)
-
- Host_Send_String( CR_LF_Host );
- Host_Send_String_With_CR('Available transfer protocols are: ');
- Host_Send_String_With_CR(' ');
- Host_Send_String_With_CR(' A Ascii');
- Host_Send_String_With_CR(' X Xmodem CheckSum');
- Host_Send_String_With_CR(' XC Xmodem CRC');
- Host_Send_String_With_CR(' Y Ymodem');
- Host_Send_String_With_CR(' YB Ymodem Batch');
- Host_Send_String_With_CR(' T Telink');
- Host_Send_String_With_CR(' M Modem7 Batch Checksum');
- Host_Send_String_With_CR(' MC Modem7 Batch CRC');
- Host_Send_String_With_CR(' K Kermit (Text file)');
- Host_Send_String_With_CR(' KB Kermit (Binary file)');
-
- END (* Display_Xfer_Protocols *);
-
- (*----------------------------------------------------------------------*)
- (* Get_Xfer_Protocol --- Get file xfer protocol *)
- (*----------------------------------------------------------------------*)
-
- FUNCTION Get_Xfer_Protocol : Transfer_Type;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Function: Get_Xfer_Protocol; *)
- (* *)
- (* Purpose: Prompts remote user for, and reads, selected file *)
- (* transfer protocol. *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Trans_Type := Get_Xfer_Protocol : Transfer_Type; *)
- (* *)
- (* Trans_Type --- Protocol chosen by remote user. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Trans_Mode : AnyStr;
- Transfer_Protocol : Transfer_Type;
-
- BEGIN (* Get_Xfer_Protocol *)
-
- REPEAT
-
- Host_Send_String( CR_LF_Host );
- Host_Prompt_And_Read_String('Enter transfer protocol: ',
- Trans_Mode, TRUE );
-
- Trans_Mode := Uppercase( TRIM( Trans_Mode ) );
-
- Transfer_Protocol := None;
-
- IF Trans_Mode = '?' THEN
- Display_Xfer_Protocols
- ELSE IF Trans_Mode = 'A' THEN
- Transfer_Protocol := Ascii
- ELSE IF Trans_Mode = 'X' THEN
- Transfer_Protocol := Xmodem_Chk
- ELSE IF Trans_Mode = 'XC' THEN
- Transfer_Protocol := Xmodem_CRC
- ELSE IF Trans_Mode = 'Y' THEN
- Transfer_Protocol := Ymodem
- ELSE IF Trans_Mode = 'YB' THEN
- Transfer_Protocol := Ymodem_Batch
- ELSE IF Trans_Mode = 'T' THEN
- Transfer_Protocol := Telink
- ELSE IF Trans_Mode = 'TC' THEN
- Transfer_Protocol := Telink
- ELSE IF Trans_Mode = 'M' THEN
- Transfer_Protocol := Modem7_Chk
- ELSE IF Trans_Mode = 'MC' THEN
- Transfer_Protocol := Modem7_CRC
- ELSE IF Trans_Mode = 'M7' THEN
- Transfer_Protocol := Modem7_CRC
- ELSE IF Trans_Mode = 'K' THEN
- BEGIN
- Transfer_Protocol := Kermit;
- Kermit_File_Type_Var := Kermit_Ascii;
- END
- ELSE IF Trans_Mode = 'KB' THEN
- BEGIN
- Transfer_Protocol := Kermit;
- Kermit_File_Type_Var := Kermit_Binary;
- END;
-
- UNTIL ( Transfer_Protocol <> None );
-
- Get_Xfer_Protocol := Transfer_Protocol;
-
- END (* Get_Xfer_Protocol *);
-
- (*----------------------------------------------------------------------*)
- (* Upload_A_File --- Receive file from remote user *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Upload_A_File;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Upload_A_File; *)
- (* *)
- (* Purpose: Prompts remote user for, and receives, selected file. *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Upload_A_File; *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- File_Name : AnyStr;
- Trans_Mode : AnyStr;
- Transfer_Protocol : Transfer_Type;
-
- BEGIN (* Upload_A_File *)
-
- Host_Send_String( CR_LF_Host );
- Host_Prompt_And_Read_String('Enter file name to upload: ',
- File_Name, TRUE );
-
- Transfer_Protocol := Get_Xfer_Protocol;
-
- IF ( Search_Xfer_List( File_Name ) ) THEN
- BEGIN
- Host_Send_String( CR_LF_Host );
- Host_Send_String_With_CR('File already exists, upload cancelled.');
- END
- ELSE IF( File_Name = 'PIBTERM.XFR' ) OR
- ( File_Name = 'PIBTERM.LOG' ) OR
- ( File_Name = 'PIBTERM.USF' ) OR
- ( File_Name = 'PIBTERM.MSG' ) OR
- ( File_Name = 'PIBTERM.CMT' ) THEN
- BEGIN
- Host_Send_String( CR_LF_Host );
- Host_Send_String_With_CR('You may not upload a file with that name.');
- END
- ELSE
- BEGIN (* FileName is global for transfers *)
- FileName := File_Name;
- Host_Send_String( CR_LF_Host );
- Host_Send_String_With_CR('Ready to receive file, begin your send procedure.');
- PibDownLoad( Transfer_Protocol );
- END;
-
- END (* Upload_A_File *);
-
- (*----------------------------------------------------------------------*)
- (* Download_A_File --- Send file to remote user *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Download_A_File;
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Download_A_File; *)
- (* *)
- (* Purpose: Prompts remote user for, and sends, selected file. *)
- (* *)
- (* Calling sequence: *)
- (* *)
- (* Download_A_File; *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- File_Name : AnyStr;
- Trans_Mode : AnyStr;
- Transfer_Protocol : Transfer_Type;
- Found_File : BOOLEAN;
-
- BEGIN (* Download_A_File *)
-
- Host_Send_String( CR_LF_Host );
- Host_Prompt_And_Read_String('Enter file name to download: ',
- File_Name, TRUE );
-
- Transfer_Protocol := Get_Xfer_Protocol;
-
- IF POS( '*', File_Name ) = 0 THEN
- BEGIN
- Found_File := Search_Xfer_List( File_Name );
- IF ( NOT Found_File ) THEN
- BEGIN
- Host_Send_String( CR_LF_Host );
- Host_Send_String_With_CR('File not found, download cancelled.');
- END;
- END
- ELSE IF Transfer_Protocol IN [ Xmodem_Chk, Xmodem_Crc, Ascii, Ymodem ] THEN
- BEGIN
- Found_File := FALSE;
- Host_Send_String( CR_LF_Host );
- Host_Send_String('Wildcards are not allowed for this protocol.');
- END
- ELSE
- Found_File := TRUE;
-
- IF Found_File THEN
- BEGIN (* FileName is global for transfers *)
- FileName := File_Name;
- Host_Send_String( CR_LF_Host );
- Host_Send_String_With_CR('Ready to send, begin your receive procedure.');
- PibUpLoad( Transfer_Protocol );
- END;
-
- END (* Download_A_File *);
-
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Process_File_Transfer_Commands *)
-
- (* No keyboard input yet *)
- Kbd_Input := FALSE;
- (* Stay in files section for a while *)
- Back := FALSE;
- (* Prompt for commands *)
- Display_Xfer_Commands;
- (* Wait for command to be entered *)
- REPEAT
- Done := Done OR ( NOT Host_Carrier_Detect );
- UNTIL Done OR Async_Receive( Ch ) OR KeyPressed;
-
- (* Process input from keyboard *)
- IF KeyPressed THEN
- BEGIN
- READ( KBD , Ch );
- Kbd_Input := TRUE;
- IF ( ORD( Ch ) = ESC ) AND KeyPressed THEN
- BEGIN
- READ( Kbd, Ch );
- IF ORD( Ch ) = F1 THEN
- Ch := 'G'
- ELSE IF ORD( Ch ) = F2 THEN
- Ch := 'Q';
- END;
- END;
-
- IF ( Not DONE ) THEN
- (* Echo command character *)
- IF Printer_On THEN
- WRITELN( Lst, Ch );
- IF Capture_On THEN
- WRITELN( Capture_File, Ch );
- Host_Send_String( Ch + CR_LF_Host );
-
- (* Process command request *)
- CASE UpCase( Ch ) OF
-
- 'U': Upload_A_File;
- 'D': Download_A_File;
- 'Q': BEGIN
- IF Kbd_Input THEN
- BEGIN
- Host_Send_String_With_CR('System operator shutting ' +
- ' down system.');
- Host_Send_String_With_CR('Thanks for calling.');
- Done := TRUE;
- END
- ELSE
- BEGIN
- Host_Send_String_With_CR('Quit and logoff');
- Done := TRUE;
- END;
- END;
- 'L': List_Files_For_Transfer;
- 'X': Expert_On := NOT Expert_On;
- 'M': BEGIN
- Back := TRUE;
- Host_Section := 'M';
- END;
- 'G': IF Kbd_Input THEN
- BEGIN
- Host_Send_String_With_CR(' ... System operator wishes' +
- ' to chat, please wait ...');
- Host_Send_String_With_CR(' ');
- Gossip_Mode;
- END;
-
- ELSE Host_Send_String( ^G );
-
- END (* CASE *)
-
- END (* Process_File_Transfer_Commands *);